Analysis of Traffic Crash Patterns and Their Contributing Factors
DS2020 - Final Project
Shivansh Patel, Manas Mathur, Muhammad Raham Saleem
Introduction
This analysis explores traffic crash patterns in our dataset, focusing on key factors that influence crash occurrence and severity. We investigate the relationships between speed limits, vehicle types, substance abuse, and various other factors that contribute to traffic accidents.
Data Preparation
# Load required libraries
library(dplyr)
library(ggplot2)
library(tidyr)
library(lubridate)
library(corrplot)
library(forcats)
library(scales)
# Load the dataset
crash_data <- read.csv("US.csv")
# Basic text cleaning function
clean_text_column <- function(x) {
x <- toupper(trimws(x))
x[x == ""] <- "UNKNOWN"
x[is.na(x)] <- "UNKNOWN"
return(x)
}
# Clean and standardize the data
crash_clean <- crash_data %>%
# First clean all character columns
mutate(across(where(is.character), clean_text_column)) %>%
# Then handle specific columns
mutate(
Weather = case_when(
Weather == "N/A" ~ "UNKNOWN",
grepl("FREEZING RAIN|FREEZING DRIZZLE", Weather) ~ "FREEZING PRECIPITATION",
grepl("BLOWING", Weather) ~ "BLOWING WEATHER",
TRUE ~ Weather
),
Traffic.Control = case_when(
Traffic.Control == "N/A" ~ "UNKNOWN",
grepl("SIGNAL", Traffic.Control) ~ "TRAFFIC SIGNAL",
TRUE ~ Traffic.Control
),
Driver.Substance.Abuse = case_when(
Driver.Substance.Abuse == "N/A" ~ "UNKNOWN",
Driver.Substance.Abuse == "NONE DETECTED" ~ "NONE",
TRUE ~ Driver.Substance.Abuse
),
Vehicle.Body.Type = case_when(
Vehicle.Body.Type == "N/A" ~ "UNKNOWN",
grepl("PASSENGER", Vehicle.Body.Type) ~ "PASSENGER VEHICLE",
TRUE ~ Vehicle.Body.Type
)
)
# Handle rare categories directly
crash_clean <- crash_clean %>%
# Weather categories
group_by(Weather) %>%
mutate(count = n()) %>%
ungroup() %>%
mutate(Weather = if_else(count < nrow(crash_clean) * 0.001, "OTHER", Weather)) %>%
select(-count) %>%
# Traffic Control categories
group_by(Traffic.Control) %>%
mutate(count = n()) %>%
ungroup() %>%
mutate(Traffic.Control = if_else(count < nrow(crash_clean) * 0.001, "OTHER", Traffic.Control)) %>%
select(-count) %>%
# Vehicle Body Type categories
group_by(Vehicle.Body.Type) %>%
mutate(count = n()) %>%
ungroup() %>%
mutate(Vehicle.Body.Type = if_else(count < nrow(crash_clean) * 0.001, "OTHER", Vehicle.Body.Type)) %>%
select(-count)
# Create severity score
crash_severity <- crash_clean %>%
mutate(
severity_score = case_when(
Injury.Severity == "FATAL INJURY" ~ 4,
Injury.Severity == "SUSPECTED SERIOUS INJURY" ~ 3,
Injury.Severity == "SUSPECTED MINOR INJURY" ~ 2,
Injury.Severity == "POSSIBLE INJURY" ~ 1,
Injury.Severity == "NO APPARENT INJURY" ~ 0,
TRUE ~ NA_real_
)
)
# Print summary to verify the cleaning
cat("Unique values in Weather after cleaning:\n")## Unique values in Weather after cleaning:print(table(crash_clean$Weather))##
## CLEAR CLOUDY FOGGY OTHER RAIN RAINING SLEET
## 128224 18616 676 727 1749 20611 218
## SNOW UNKNOWN WINTRY MIX
## 1569 14150 391cat("\nUnique values in Traffic.Control after cleaning:\n")##
## Unique values in Traffic.Control after cleaning:print(table(crash_clean$Traffic.Control))##
## NO CONTROLS OTHER PERSON STOP SIGN TRAFFIC SIGNAL
## 75608 2526 282 13326 66290
## UNKNOWN YIELD SIGN
## 27038 1861cat("\nUnique values in Vehicle.Body.Type after cleaning:\n")##
## Unique values in Vehicle.Body.Type after cleaning:print(table(crash_clean$Vehicle.Body.Type))##
## (SPORT) UTILITY VEHICLE
## 15990
## AMBULANCE/EMERGENCY
## 466
## BUS - SCHOOL
## 338
## BUS - TRANSIT
## 387
## CARGO VAN/LIGHT TRUCK 2 AXLES (OVER 10,000LBS (4,536 KG))
## 1858
## FIRE VEHICLE/EMERGENCY
## 437
## FIRE VEHICLE/NON EMERGENCY
## 296
## MEDIUM/HEAVY TRUCKS 3 AXLES (OVER 10,000LBS (4,536KG))
## 1469
## MOTORCYCLE
## 889
## OTHER
## 2733
## OTHER BUS
## 418
## OTHER LIGHT TRUCKS (10,000LBS (4,536KG) OR LESS)
## 1909
## OTHER TRUCKS
## 195
## PASSENGER VEHICLE
## 128930
## PICKUP
## 776
## PICKUP TRUCK
## 6787
## POLICE VEHICLE/EMERGENCY
## 1497
## POLICE VEHICLE/NON EMERGENCY
## 2119
## RECREATIONAL VEHICLE
## 197
## SCHOOL BUS
## 2975
## SPORT UTILITY VEHICLE
## 2391
## STATION WAGON
## 790
## TRANSIT BUS
## 3642
## TRUCK TRACTOR
## 548
## UNKNOWN
## 3936
## VAN
## 4958Analysis 1: Speed Zones and Crash Patterns
Research Question
What speed zones result in the most crashes, and how does this affect crash severity
colnames(crash_clean)## [1] "Report.Number" "Local.Case.Number"
## [3] "Agency.Name" "ACRS.Report.Type"
## [5] "Crash.Date.Time" "Route.Type"
## [7] "Road.Name" "Cross.Street.Name"
## [9] "Off.Road.Description" "Municipality"
## [11] "Related.Non.Motorist" "Collision.Type"
## [13] "Weather" "Surface.Condition"
## [15] "Light" "Traffic.Control"
## [17] "Driver.Substance.Abuse" "Non.Motorist.Substance.Abuse"
## [19] "Person.ID" "Driver.At.Fault"
## [21] "Injury.Severity" "Circumstance"
## [23] "Driver.Distracted.By" "Drivers.License.State"
## [25] "Vehicle.ID" "Vehicle.Damage.Extent"
## [27] "Vehicle.First.Impact.Location" "Vehicle.Body.Type"
## [29] "Vehicle.Movement" "Vehicle.Going.Dir"
## [31] "Speed.Limit" "Driverless.Vehicle"
## [33] "Parked.Vehicle" "Vehicle.Year"
## [35] "Vehicle.Make" "Vehicle.Model"
## [37] "Latitude" "Longitude"
## [39] "Location"unique(crash_clean$Driver.Distracted.By)## [1] "UNKNOWN"
## [2] "NOT DISTRACTED"
## [3] "LOOKED BUT DID NOT SEE"
## [4] "INATTENTIVE OR LOST IN THOUGHT"
## [5] "TALKING OR LISTENING TO CELLULAR PHONE"
## [6] "OTHER DISTRACTION"
## [7] "DISTRACTED BY OUTSIDE PERSON OBJECT OR EVENT"
## [8] "EATING OR DRINKING"
## [9] "BY MOVING OBJECT IN VEHICLE"
## [10] "BY OTHER OCCUPANTS"
## [11] "ADJUSTING AUDIO AND OR CLIMATE CONTROLS"
## [12] "NO DRIVER PRESENT"
## [13] "OTHER ELECTRONIC DEVICE (NAVIGATIONAL PALM PILOT)"
## [14] "OTHER CELLULAR PHONE RELATED"
## [15] "USING OTHER DEVICE CONTROLS INTEGRAL TO VEHICLE"
## [16] "USING DEVICE OBJECT BROUGHT INTO VEHICLE"
## [17] "DIALING CELLULAR PHONE"
## [18] "TEXTING FROM A CELLULAR PHONE"
## [19] "SMOKING RELATED"
## [20] "OTHER ACTION (LOOKING AWAY FROM TASK, ETC.)"
## [21] "TALKING/LISTENING"
## [22] "MANUALLY OPERATING (DIALING, PLAYING GAME, ETC.)"speed_limit_crashes <- table(crash_clean$Speed.Limit)
speed_limit_summary <- data.frame(
speed_limit = names(speed_limit_crashes),
crash_count = as.numeric(speed_limit_crashes)
)
speed_limit_summary <- speed_limit_summary[order(-speed_limit_summary$crash_count), ]
print(speed_limit_summary)## speed_limit crash_count
## 8 35 55496
## 9 40 35615
## 6 25 26258
## 7 30 25673
## 10 45 13135
## 4 15 6378
## 1 0 6068
## 11 50 5000
## 2 5 4315
## 12 55 4292
## 3 10 3181
## 5 20 1367
## 13 60 85
## 14 65 59
## 15 70 8
## 16 75 1library(ggplot2)
ggplot(speed_limit_summary, aes(x = speed_limit, y = crash_count)) +
geom_bar(stat = "identity", fill = "steelblue") +
theme_minimal() +
labs(
title = "Crash Frequency by Speed Limit",
x = "Speed Limit",
y = "Number of Crashes"
) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
head(crash_clean$Crash.Date.Time, 1)## [1] "05/27/2021 07:40:00 PM"nrow(crash_clean)## [1] 186931Analysis 2: Lights, surfaces, and injury severity
Research Question
What combinations of lighting and surfaces result in the worst injuries?
crash_analysis <- crash_clean %>%
filter(!Light %in% c("N/A",
"DARK -- UNKNOWN LIGHTING",
"UNKNOWN",
"OTHER",
"DARK - UNKNOWN LIGHTING")) %>%
filter(!Surface.Condition %in% c("N/A",
"OTHER",
"UNKNOWN")) %>%
mutate(Light = case_when(
Light %in% c("DARK LIGHTS ON", "DARK - LIGHTED") ~ "DARK WITH LIGHTS",
Light %in% c("DARK NO LIGHTS", "DARK - NOT LIGHTED") ~ "DARK WITHOUT LIGHTS",
TRUE ~ Light
)) %>%
mutate(Surface.Condition = case_when(
Surface.Condition %in% c("WATER(STANDING/MOVING)", "WATER (STANDING, MOVING)") ~ "WATER (STANDING/MOVING)",
TRUE ~ Surface.Condition
)) %>%
mutate(Surface.Condition = case_when(
Surface.Condition %in% c("ICE/FROST", "ICE") ~ "ICE",
TRUE ~ Surface.Condition
)) %>%
mutate(
severity_score = case_when(
Injury.Severity == "FATAL INJURY" ~ 4,
Injury.Severity == "SUSPECTED SERIOUS INJURY" ~ 3,
Injury.Severity == "SUSPECTED MINOR INJURY" ~ 2,
Injury.Severity == "POSSIBLE INJURY" ~ 1,
Injury.Severity == "NO APPARENT INJURY" ~ 0,
TRUE ~ NA_real_
)
)
severity_by_conditions <- crash_analysis %>%
group_by(Light, Surface.Condition) %>%
summarise(
avg_severity = mean(severity_score, na.rm = TRUE),
n_crashes = n(),
.groups = 'drop'
) %>%
arrange(desc(avg_severity))
print(head(severity_by_conditions, 10))## # A tibble: 10 × 4
## Light Surface.Condition avg_severity n_crashes
## <chr> <chr> <dbl> <int>
## 1 DAYLIGHT MUD, DIRT, GRAVEL 0.684 38
## 2 DAYLIGHT WATER (STANDING/MOVING) 0.625 16
## 3 DAYLIGHT OIL 0.583 24
## 4 DARK WITHOUT LIGHTS WATER (STANDING/MOVING) 0.5 8
## 5 DAWN SLUSH 0.4 10
## 6 DARK WITHOUT LIGHTS ICE 0.374 123
## 7 DAYLIGHT SLUSH 0.364 140
## 8 DARK WITH LIGHTS SLUSH 0.34 50
## 9 DARK WITHOUT LIGHTS DRY 0.337 3555
## 10 DUSK WET 0.335 807ggplot(severity_by_conditions,
aes(x = Surface.Condition,
y = avg_severity,
fill = Light)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.9)) +
coord_flip() +
theme_minimal() +
theme(
axis.text.y = element_text(size = 10),
panel.grid.major.y = element_blank(),
legend.position = "bottom"
) +
labs(title = "Average Crash Severity by Light and Surface Conditions",
subtitle = "Severity Score: 0 (No Injury) to 1 (Fatal)",
x = "Surface Condition",
y = "Average Severity Score",
fill = "Lighting Condition")
substance_present <- c("ALCOHOL CONTRIBUTED", "ALCOHOL PRESENT",
"COMBINATION CONTRIBUTED", "COMBINED SUBSTANCE PRESENT",
"ILLEGAL DRUG CONTRIBUTED", "ILLEGAL DRUG PRESENT",
"MEDICATION CONTRIBUTED", "MEDICATION PRESENT",
"SUSPECT OF ALCOHOL USE, SUSPECT OF DRUG USE",
"NOT SUSPECT OF ALCOHOL USE, SUSPECT OF DRUG USE",
"SUSPECT OF ALCOHOL USE, NOT SUSPECT OF DRUG USE")
crash_analysis <- crash_clean %>%
mutate(
crash_datetime = as.POSIXct(Crash.Date.Time, format = "%m/%d/%Y %I:%M:%S %p"),
day_of_week = weekdays(crash_datetime),
day_of_week = factor(day_of_week,
levels = c("Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday", "Sunday")),
severity_score = case_when(
Injury.Severity == "FATAL INJURY" ~ 4,
Injury.Severity == "SUSPECTED SERIOUS INJURY" ~ 3,
Injury.Severity == "SUSPECTED MINOR INJURY" ~ 2,
Injury.Severity == "POSSIBLE INJURY" ~ 1,
Injury.Severity == "NO APPARENT INJURY" ~ 0,
TRUE ~ NA_real_
),
has_substance = Driver.Substance.Abuse %in% substance_present
)
severity_by_day <- crash_analysis %>%
group_by(day_of_week, has_substance) %>%
summarise(
avg_severity = mean(severity_score, na.rm = TRUE),
n_crashes = n(),
se = sd(severity_score, na.rm = TRUE) / sqrt(n()),
.groups = 'drop'
)
ggplot(severity_by_day) +
geom_line(aes(x = day_of_week,
y = avg_severity,
group = has_substance,
color = has_substance),
size = 1.2) +
geom_point(aes(x = day_of_week,
y = avg_severity,
color = has_substance),
size = 3) +
scale_color_manual(values = c("lightblue", "red"),
labels = c("Non-Substance Related", "Substance Related")) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.title = element_blank(),
legend.position = "bottom"
) +
labs(
title = "Average Crash Severity by Day of Week",
subtitle = "Comparing Substance-Related vs Non-Substance-Related Crashes",
x = "Day of Week",
y = "Average Severity Score (0-4)"
)
Analysis 3: Impact Locations and Crash Patterns
Research Question
How do Impact Zones affect crash severity
library(sf)
library(tigris)
library(dplyr)
library(lubridate)
crash_coords <- crash_clean %>%
select(Longitude, Latitude)
nrow(crash_coords)## [1] 186931crash_sf <- st_as_sf(crash_coords, coords = c("Longitude", "Latitude"), crs = 4326)
states <- states(cb = TRUE) %>%
st_transform(crs = 4326) ## | | | 0% | |= | 1% | |= | 2% | |== | 2% | |== | 3% | |=== | 4% | |=== | 5% | |==== | 5% | |==== | 6% | |===== | 6% | |===== | 7% | |===== | 8% | |====== | 8% | |====== | 9% | |======= | 9% | |======= | 10% | |======== | 11% | |======== | 12% | |========= | 12% | |========= | 13% | |========== | 14% | |========== | 15% | |=========== | 15% | |=========== | 16% | |============ | 17% | |============ | 18% | |============= | 18% | |============= | 19% | |============== | 20% | |============== | 21% | |=============== | 21% | |=============== | 22% | |================ | 23% | |================ | 24% | |================= | 24% | |================= | 25% | |================== | 25% | |================== | 26% | |=================== | 27% | |=================== | 28% | |==================== | 28% | |==================== | 29% | |===================== | 29% | |===================== | 30% | |====================== | 31% | |====================== | 32% | |======================= | 32% | |======================= | 33% | |======================== | 34% | |======================== | 35% | |========================= | 35% | |========================= | 36% | |========================== | 37% | |========================== | 38% | |=========================== | 38% | |=========================== | 39% | |============================ | 40% | |============================= | 41% | |============================= | 42% | |============================== | 42% | |============================== | 43% | |=============================== | 44% | |=============================== | 45% | |================================ | 45% | |================================ | 46% | |================================= | 47% | |================================= | 48% | |================================== | 48% | |================================== | 49% | |=================================== | 50% | |=================================== | 51% | |==================================== | 51% | |==================================== | 52% | |===================================== | 53% | |====================================== | 54% | |====================================== | 55% | |======================================= | 55% | |======================================= | 56% | |======================================== | 56% | |======================================== | 57% | |========================================= | 58% | |========================================= | 59% | |========================================== | 59% | |========================================== | 60% | |=========================================== | 61% | |=========================================== | 62% | |============================================ | 62% | |============================================ | 63% | |============================================= | 64% | |============================================= | 65% | |============================================== | 65% | |============================================== | 66% | |=============================================== | 67% | |=============================================== | 68% | |================================================ | 68% | |================================================ | 69% | |================================================= | 69% | |================================================= | 70% | |================================================== | 71% | |================================================== | 72% | |=================================================== | 72% | |=================================================== | 73% | |==================================================== | 74% | |==================================================== | 75% | |===================================================== | 75% | |===================================================== | 76% | |====================================================== | 77% | |====================================================== | 78% | |======================================================= | 78% | |======================================================= | 79% | |======================================================== | 80% | |======================================================== | 81% | |========================================================= | 81% | |========================================================= | 82% | |========================================================== | 83% | |========================================================== | 84% | |=========================================================== | 84% | |=========================================================== | 85% | |============================================================ | 85% | |============================================================ | 86% | |============================================================= | 86% | |============================================================= | 87% | |============================================================== | 88% | |============================================================== | 89% | |=============================================================== | 89% | |=============================================================== | 90% | |================================================================ | 91% | |================================================================ | 92% | |================================================================= | 92% | |================================================================= | 93% | |================================================================== | 94% | |================================================================== | 95% | |=================================================================== | 95% | |=================================================================== | 96% | |==================================================================== | 97% | |==================================================================== | 98% | |===================================================================== | 98% | |===================================================================== | 99% | |======================================================================| 99% | |======================================================================| 100%crash_with_states <- st_join(crash_sf, states["NAME"])
crash_states_df <- crash_with_states %>%
mutate(row_num = row_number()) %>%
st_drop_geometry() %>%
select(NAME, row_num)
crash_clean_with_states <- crash_clean %>%
mutate(row_num = row_number()) %>%
left_join(crash_states_df, by = "row_num") %>%
rename(state = NAME) %>%
select(-row_num)
crash_maryland_injuries <- crash_clean_with_states %>%
mutate(date = mdy_hms(Crash.Date.Time)) %>%
filter(year(date) == 2024,
# state == "Maryland",
Injury.Severity != "NO APPARENT INJURY",
# Injury.Severity != "POSSIBLE INJURY",
Injury.Severity != "UNKNOWN",
Vehicle.First.Impact.Location != "NON-COLLISION",
Vehicle.First.Impact.Location != "VEHICLE NOT AT SCENE")
colnames(crash_maryland_injuries)## [1] "Report.Number" "Local.Case.Number"
## [3] "Agency.Name" "ACRS.Report.Type"
## [5] "Crash.Date.Time" "Route.Type"
## [7] "Road.Name" "Cross.Street.Name"
## [9] "Off.Road.Description" "Municipality"
## [11] "Related.Non.Motorist" "Collision.Type"
## [13] "Weather" "Surface.Condition"
## [15] "Light" "Traffic.Control"
## [17] "Driver.Substance.Abuse" "Non.Motorist.Substance.Abuse"
## [19] "Person.ID" "Driver.At.Fault"
## [21] "Injury.Severity" "Circumstance"
## [23] "Driver.Distracted.By" "Drivers.License.State"
## [25] "Vehicle.ID" "Vehicle.Damage.Extent"
## [27] "Vehicle.First.Impact.Location" "Vehicle.Body.Type"
## [29] "Vehicle.Movement" "Vehicle.Going.Dir"
## [31] "Speed.Limit" "Driverless.Vehicle"
## [33] "Parked.Vehicle" "Vehicle.Year"
## [35] "Vehicle.Make" "Vehicle.Model"
## [37] "Latitude" "Longitude"
## [39] "Location" "state"
## [41] "date"colnames(crash_maryland_injuries)## [1] "Report.Number" "Local.Case.Number"
## [3] "Agency.Name" "ACRS.Report.Type"
## [5] "Crash.Date.Time" "Route.Type"
## [7] "Road.Name" "Cross.Street.Name"
## [9] "Off.Road.Description" "Municipality"
## [11] "Related.Non.Motorist" "Collision.Type"
## [13] "Weather" "Surface.Condition"
## [15] "Light" "Traffic.Control"
## [17] "Driver.Substance.Abuse" "Non.Motorist.Substance.Abuse"
## [19] "Person.ID" "Driver.At.Fault"
## [21] "Injury.Severity" "Circumstance"
## [23] "Driver.Distracted.By" "Drivers.License.State"
## [25] "Vehicle.ID" "Vehicle.Damage.Extent"
## [27] "Vehicle.First.Impact.Location" "Vehicle.Body.Type"
## [29] "Vehicle.Movement" "Vehicle.Going.Dir"
## [31] "Speed.Limit" "Driverless.Vehicle"
## [33] "Parked.Vehicle" "Vehicle.Year"
## [35] "Vehicle.Make" "Vehicle.Model"
## [37] "Latitude" "Longitude"
## [39] "Location" "state"
## [41] "date"unique(crash_maryland_injuries$Injury.Severity)## [1] "POSSIBLE INJURY" "SUSPECTED MINOR INJURY"
## [3] "SUSPECTED SERIOUS INJURY" "FATAL INJURY"crash_maryland_injuries$Injury.Severity <- factor(crash_maryland_injuries$Injury.Severity, levels = c('SUSPECTED MINOR INJURY', 'SUSPECTED SERIOUS INJURY', 'FATAL INJURY'))
impact_injury_table <- table(crash_maryland_injuries$Vehicle.First.Impact.Location,
crash_maryland_injuries$Injury.Severity)
impact_injury_prop <- prop.table(impact_injury_table, margin = 1) * 100
ggplot(data = as.data.frame.table(impact_injury_prop),
aes(x = reorder(Var1, -table(Var1)), y = Freq, fill = Var2)) +
geom_bar(stat = "identity", position = "stack") +
theme_minimal() +
labs(x = "Impact Location",
y = "Count",
fill = "Injury Severity",
title = "Relationship between Impact Location and Injury Severity") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
chisq_test <- chisq.test(table(crash_maryland_injuries$Vehicle.First.Impact.Location,
crash_maryland_injuries$Injury.Severity))
chisq_test##
## Pearson's Chi-squared test
##
## data: table(crash_maryland_injuries$Vehicle.First.Impact.Location, crash_maryland_injuries$Injury.Severity)
## X-squared = 66.004, df = 28, p-value = 6.599e-05library(effectsize)
cramers_v <- cramers_v(crash_maryland_injuries$Vehicle.First.Impact.Location,
crash_maryland_injuries$Injury.Severity)
stdres <- chisq_test$stdres
stdres##
## SUSPECTED MINOR INJURY SUSPECTED SERIOUS INJURY FATAL INJURY
## CARGO LOSS 0.670631388 -0.626612700 -0.217529932
## EIGHT O CLOCK 1.155384910 -1.002110840 -0.580339631
## ELEVEN O CLOCK -0.863758858 1.185928473 -0.725595587
## FIVE O CLOCK 0.920678846 -1.512479051 1.432837244
## FOUR O CLOCK -1.563290377 0.473408716 3.127978960
## NINE O CLOCK -2.249379445 2.313861273 0.166492904
## ONE O CLOCK 0.497974816 -0.375971079 -0.398637420
## SEVEN O CLOCK 1.281585224 -1.760841483 1.079889102
## SIX O CLOCK 3.581175022 -3.160764795 -1.653658812
## TEN O CLOCK -1.346933925 1.277559824 0.386365949
## THREE O CLOCK -1.175399840 0.472370839 2.042774659
## TOP -1.416803723 1.650750079 -0.408367953
## TWELVE O CLOCK 0.423495079 0.130360413 -1.533890390
## TWO O CLOCK -2.912284288 2.262926187 2.161032531
## UNDERSIDE 0.008673926 -0.992812233 2.611282709impact_freq <- table(crash_maryland_injuries$Vehicle.First.Impact.Location)
impact_freq_sorted <- sort(impact_freq, decreasing = TRUE)
impact_chisq <- chisq.test(impact_freq)
library(ggplot2)
impact_df <- data.frame(
location = names(impact_freq),
count = as.numeric(impact_freq)
)
ggplot(impact_df, aes(x = reorder(location, -count), y = count)) +
geom_bar(stat = "identity") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = "Impact Location",
y = "Frequency",
title = "Distribution of Vehicle Impact Locations")
weights <- 1 / table(crash_maryland_injuries$Vehicle.First.Impact.Location)
weights <- weights[crash_maryland_injuries$Vehicle.First.Impact.Location]
weighted.chisq <- chisq.test(table(crash_maryland_injuries$Vehicle.First.Impact.Location,
crash_maryland_injuries$Injury.Severity),
weights)
weighted.chisq##
## Pearson's Chi-squared test
##
## data: table(crash_maryland_injuries$Vehicle.First.Impact.Location, crash_maryland_injuries$Injury.Severity)
## X-squared = 66.004, df = 28, p-value = 6.599e-05first_impact_severity <- crash_severity %>%
group_by(Vehicle.First.Impact.Location) %>%
summarise(
avg_severity = mean(severity_score, na.rm = TRUE),
crash_count = n()
) %>% filter(Vehicle.First.Impact.Location != "UNKNOWN", Vehicle.First.Impact.Location != "VEHICLE NOT AT SCENE",crash_count > 10)
ggplot(first_impact_severity, aes(x = reorder(Vehicle.First.Impact.Location, -avg_severity), y = avg_severity)) +
geom_bar(stat = "identity", fill = "black") +
geom_text(aes(label = round(avg_severity, 2)), vjust = -0.5) +
labs(
title = "Average Crash Severity by Vehicle Impact Location",
x = "Type of impact",
y = "Average Severity Score"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
library(mapview)
crash_maryland_sf <- st_as_sf(crash_maryland_injuries,
coords = c("Longitude", "Latitude"),
crs = 4326)
colnames(crash_maryland_sf)## [1] "Report.Number" "Local.Case.Number"
## [3] "Agency.Name" "ACRS.Report.Type"
## [5] "Crash.Date.Time" "Route.Type"
## [7] "Road.Name" "Cross.Street.Name"
## [9] "Off.Road.Description" "Municipality"
## [11] "Related.Non.Motorist" "Collision.Type"
## [13] "Weather" "Surface.Condition"
## [15] "Light" "Traffic.Control"
## [17] "Driver.Substance.Abuse" "Non.Motorist.Substance.Abuse"
## [19] "Person.ID" "Driver.At.Fault"
## [21] "Injury.Severity" "Circumstance"
## [23] "Driver.Distracted.By" "Drivers.License.State"
## [25] "Vehicle.ID" "Vehicle.Damage.Extent"
## [27] "Vehicle.First.Impact.Location" "Vehicle.Body.Type"
## [29] "Vehicle.Movement" "Vehicle.Going.Dir"
## [31] "Speed.Limit" "Driverless.Vehicle"
## [33] "Parked.Vehicle" "Vehicle.Year"
## [35] "Vehicle.Make" "Vehicle.Model"
## [37] "Location" "state"
## [39] "date" "geometry"severity_colors <- c("FATAL" = "red",
"NO APPARENT INJURY" = "green",
"POSSIBLE INJURY" = "blue",
"SUSPECTED MINOR INJURY" = "yellow",
"SUSPECTED SERIOUS INJURY" = "orange"
)
mapview(crash_maryland_sf,
zcol = "Injury.Severity",
col.regions = severity_colors,
cex = 3,
alpha = 0.8,
legend = TRUE,
popup = c("Injury.Severity"),
layer.name = "Crash Severity")mapview(crash_maryland_sf,
zcol = "Vehicle.First.Impact.Location",
col.regions = severity_colors,
cex = 3,
alpha = 0.8,
legend = TRUE,
popup = c("Injury.Severity"),
layer.name = "Crash Severity")Analysis 2: Factors Affecting Crash Severity
Research Question
What factors correlate most strongly with crash severity?
# Extract hour from Crash.Date.Time
crash_severity <- crash_severity %>%
mutate(
crash_hour = hour(as.POSIXct(Crash.Date.Time, format="%m/%d/%Y %I:%M:%S %p")),
time_of_day = case_when(
crash_hour >= 5 & crash_hour < 12 ~ "Morning",
crash_hour >= 12 & crash_hour < 17 ~ "Afternoon",
crash_hour >= 17 & crash_hour < 22 ~ "Evening",
TRUE ~ "Night"
)
)
# Analyze severity by time of day
time_severity <- crash_severity %>%
group_by(time_of_day) %>%
summarise(
avg_severity = mean(severity_score, na.rm = TRUE),
crash_count = n()
)
# Visualize time of day patterns
ggplot(time_severity, aes(x = time_of_day, y = avg_severity)) +
geom_bar(stat = "identity", fill = "steelblue") +
geom_text(aes(label = round(avg_severity, 2)), vjust = -0.5) +
labs(
title = "Average Crash Severity by Time of Day",
x = "Time of Day",
y = "Average Severity Score"
) +
theme_minimal()
# Analyze severity by weather conditions
weather_severity <- crash_severity %>%
group_by(Weather) %>%
summarise(
avg_severity = mean(severity_score, na.rm = TRUE),
crash_count = n()
) %>%
filter(!is.na(Weather), Weather != "", crash_count > 10) # Remove sparse categories
# Visualize weather patterns
ggplot(weather_severity, aes(x = reorder(Weather, -avg_severity), y = avg_severity)) +
geom_bar(stat = "identity", fill = "darkred") +
geom_text(aes(label = round(avg_severity, 2)), vjust = -0.5) +
labs(
title = "Average Crash Severity by Weather Condition",
x = "Weather Condition",
y = "Average Severity Score"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Analyze severity by traffic control presence
control_severity <- crash_severity %>%
group_by(Traffic.Control) %>%
summarise(
avg_severity = mean(severity_score, na.rm = TRUE),
crash_count = n()
) %>%
filter(!is.na(Traffic.Control), Traffic.Control != "", crash_count > 10)
# Visualize traffic control patterns
ggplot(control_severity, aes(x = reorder(Traffic.Control, -avg_severity), y = avg_severity)) +
geom_bar(stat = "identity", fill = "forestgreen") +
geom_text(aes(label = round(avg_severity, 2)), vjust = -0.5) +
labs(
title = "Average Crash Severity by Traffic Control Type",
x = "Traffic Control",
y = "Average Severity Score"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Analyze severity by driver distraction
distraction_severity <- crash_severity %>%
group_by(Driver.Distracted.By) %>%
summarise(
avg_severity = mean(severity_score, na.rm = TRUE),
crash_count = n()
) %>%
filter(!is.na(Driver.Distracted.By), Driver.Distracted.By != "", crash_count > 10)
# Visualize distraction patterns
ggplot(distraction_severity, aes(x = reorder(Driver.Distracted.By, -avg_severity), y = avg_severity)) +
geom_bar(stat = "identity", fill = "purple") +
geom_text(aes(label = round(avg_severity, 2)), vjust = -0.5) +
labs(
title = "Average Crash Severity by Driver Distraction",
x = "Distraction Type",
y = "Average Severity Score"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Analyze severity by vehicle movement
movement_severity <- crash_severity %>%
group_by(Vehicle.Movement) %>%
summarise(
avg_severity = mean(severity_score, na.rm = TRUE),
crash_count = n()
) %>%
filter(!is.na(Vehicle.Movement), Vehicle.Movement != "", crash_count > 10)
# Visualize movement patterns
ggplot(movement_severity, aes(x = reorder(Vehicle.Movement, -avg_severity), y = avg_severity)) +
geom_bar(stat = "identity", fill = "orange") +
geom_text(aes(label = round(avg_severity, 2)), vjust = -0.5) +
labs(
title = "Average Crash Severity by Vehicle Movement",
x = "Vehicle Movement",
y = "Average Severity Score"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Chi-square test for categorical variables
# Weather and Severity
weather_chi <- table(crash_severity$Weather, crash_severity$Injury.Severity)
weather_test <- chisq.test(weather_chi)
# Traffic Control and Severity
control_chi <- table(crash_severity$Traffic.Control, crash_severity$Injury.Severity)
control_test <- chisq.test(control_chi)
# Create a summary of statistical tests
test_results <- data.frame(
Factor = c("Weather", "Traffic Control"),
Chi_Square = c(weather_test$statistic, control_test$statistic),
P_Value = c(weather_test$p.value, control_test$p.value)
)
# Print test results
print(test_results)## Factor Chi_Square P_Value
## 1 Weather 732.5145 5.093479e-125
## 2 Traffic Control 1173.6219 9.556008e-228# Perform logistic regression for severe crashes
crash_severity$is_severe <- crash_severity$severity_score >= 3
# Create logistic regression model
severe_model <- glm(is_severe ~
Weather +
time_of_day +
Traffic.Control +
Vehicle.Movement,
data = crash_severity,
family = "binomial")
# Print model summary
summary(severe_model)##
## Call:
## glm(formula = is_severe ~ Weather + time_of_day + Traffic.Control +
## Vehicle.Movement, family = "binomial", data = crash_severity)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.457115 0.108512 -41.075 < 2e-16
## WeatherCLOUDY 0.124249 0.079018 1.572 0.115853
## WeatherFOGGY -0.002277 0.358430 -0.006 0.994931
## WeatherOTHER -1.007645 0.580252 -1.737 0.082464
## WeatherRAIN -0.296923 0.272855 -1.088 0.276504
## WeatherRAINING -0.338748 0.087963 -3.851 0.000118
## WeatherSLEET 0.338705 0.584535 0.579 0.562290
## WeatherSNOW -1.245288 0.451130 -2.760 0.005774
## WeatherUNKNOWN -0.299982 0.102683 -2.921 0.003484
## WeatherWINTRY MIX 0.269703 0.416615 0.647 0.517395
## time_of_dayEvening -0.043874 0.066378 -0.661 0.508632
## time_of_dayMorning 0.022744 0.063134 0.360 0.718655
## time_of_dayNight 0.368535 0.076328 4.828 1.38e-06
## Traffic.ControlOTHER -0.044753 0.208853 -0.214 0.830328
## Traffic.ControlPERSON -11.678015 139.329970 -0.084 0.933203
## Traffic.ControlSTOP SIGN -0.259321 0.104983 -2.470 0.013507
## Traffic.ControlTRAFFIC SIGNAL -0.063242 0.056971 -1.110 0.266973
## Traffic.ControlUNKNOWN -0.090670 0.076278 -1.189 0.234567
## Traffic.ControlYIELD SIGN -0.593036 0.337529 -1.757 0.078919
## Vehicle.MovementBACKING -2.621769 0.458278 -5.721 1.06e-08
## Vehicle.MovementCHANGING LANES -0.624227 0.207266 -3.012 0.002598
## Vehicle.MovementDRIVERLESS MOVING VEH. -12.158276 393.766407 -0.031 0.975368
## Vehicle.MovementENTERING TRAFFIC LANE -0.389759 0.368323 -1.058 0.289965
## Vehicle.MovementLEAVING TRAFFIC LANE 1.227426 0.337474 3.637 0.000276
## Vehicle.MovementMAKING LEFT TURN -0.164258 0.126863 -1.295 0.195402
## Vehicle.MovementMAKING RIGHT TURN -0.992411 0.238657 -4.158 3.21e-05
## Vehicle.MovementMAKING U TURN -0.984086 0.458417 -2.147 0.031817
## Vehicle.MovementMAKING U-TURN -12.079644 205.348799 -0.059 0.953091
## Vehicle.MovementMOVING CONSTANT SPEED 0.247876 0.101116 2.451 0.014230
## Vehicle.MovementN/A -0.023856 0.512156 -0.047 0.962849
## Vehicle.MovementNEGOTIATING A CURVE 1.225739 0.220483 5.559 2.71e-08
## Vehicle.MovementOTHER 0.452984 0.278232 1.628 0.103508
## Vehicle.MovementOVERTAKING/PASSING 0.218496 0.719044 0.304 0.761227
## Vehicle.MovementPARKED -2.114232 0.510084 -4.145 3.40e-05
## Vehicle.MovementPARKING -1.959243 0.586441 -3.341 0.000835
## Vehicle.MovementPASSING -0.135368 0.348981 -0.388 0.698094
## Vehicle.MovementRIGHT TURN ON RED -0.353932 0.716930 -0.494 0.621535
## Vehicle.MovementSKIDDING 1.077079 0.255381 4.218 2.47e-05
## Vehicle.MovementSLOWING OR STOPPING -1.080971 0.141356 -7.647 2.05e-14
## Vehicle.MovementSTARTING FROM LANE -0.737737 0.234518 -3.146 0.001657
## Vehicle.MovementSTARTING FROM PARKED -1.930816 0.586076 -3.294 0.000986
## Vehicle.MovementSTOPPED IN TRAFFIC -1.499589 0.586454 -2.557 0.010557
## Vehicle.MovementSTOPPED IN TRAFFIC LANE -0.984711 0.151831 -6.486 8.84e-11
## Vehicle.MovementTURNING LEFT 0.156773 0.246250 0.637 0.524357
## Vehicle.MovementTURNING RIGHT -1.747679 1.005785 -1.738 0.082277
## Vehicle.MovementUNKNOWN 0.639997 0.158456 4.039 5.37e-05
##
## (Intercept) ***
## WeatherCLOUDY
## WeatherFOGGY
## WeatherOTHER .
## WeatherRAIN
## WeatherRAINING ***
## WeatherSLEET
## WeatherSNOW **
## WeatherUNKNOWN **
## WeatherWINTRY MIX
## time_of_dayEvening
## time_of_dayMorning
## time_of_dayNight ***
## Traffic.ControlOTHER
## Traffic.ControlPERSON
## Traffic.ControlSTOP SIGN *
## Traffic.ControlTRAFFIC SIGNAL
## Traffic.ControlUNKNOWN
## Traffic.ControlYIELD SIGN .
## Vehicle.MovementBACKING ***
## Vehicle.MovementCHANGING LANES **
## Vehicle.MovementDRIVERLESS MOVING VEH.
## Vehicle.MovementENTERING TRAFFIC LANE
## Vehicle.MovementLEAVING TRAFFIC LANE ***
## Vehicle.MovementMAKING LEFT TURN
## Vehicle.MovementMAKING RIGHT TURN ***
## Vehicle.MovementMAKING U TURN *
## Vehicle.MovementMAKING U-TURN
## Vehicle.MovementMOVING CONSTANT SPEED *
## Vehicle.MovementN/A
## Vehicle.MovementNEGOTIATING A CURVE ***
## Vehicle.MovementOTHER
## Vehicle.MovementOVERTAKING/PASSING
## Vehicle.MovementPARKED ***
## Vehicle.MovementPARKING ***
## Vehicle.MovementPASSING
## Vehicle.MovementRIGHT TURN ON RED
## Vehicle.MovementSKIDDING ***
## Vehicle.MovementSLOWING OR STOPPING ***
## Vehicle.MovementSTARTING FROM LANE **
## Vehicle.MovementSTARTING FROM PARKED ***
## Vehicle.MovementSTOPPED IN TRAFFIC *
## Vehicle.MovementSTOPPED IN TRAFFIC LANE ***
## Vehicle.MovementTURNING LEFT
## Vehicle.MovementTURNING RIGHT .
## Vehicle.MovementUNKNOWN ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 19489 on 186019 degrees of freedom
## Residual deviance: 18739 on 185974 degrees of freedom
## (911 observations deleted due to missingness)
## AIC: 18831
##
## Number of Fisher Scoring iterations: 15# Create a summary table of the most significant factors
factor_summary <- data.frame(
Factor = c("Time of Day", "Weather", "Traffic Control",
"Driver Distraction", "Vehicle Movement"),
Average_Severity = c(
max(time_severity$avg_severity),
max(weather_severity$avg_severity),
max(control_severity$avg_severity),
max(distraction_severity$avg_severity),
max(movement_severity$avg_severity)
),
Most_Severe_Category = c(
time_severity$time_of_day[which.max(time_severity$avg_severity)],
weather_severity$Weather[which.max(weather_severity$avg_severity)],
control_severity$Traffic.Control[which.max(control_severity$avg_severity)],
distraction_severity$Driver.Distracted.By[which.max(distraction_severity$avg_severity)],
movement_severity$Vehicle.Movement[which.max(movement_severity$avg_severity)]
)
)
# Print the summary table
print(factor_summary)## Factor Average_Severity Most_Severe_Category
## 1 Time of Day 0.2948336 Night
## 2 Weather 0.2992327 WINTRY MIX
## 3 Traffic Control 0.3110519 TRAFFIC SIGNAL
## 4 Driver Distraction 0.3880597 TEXTING FROM A CELLULAR PHONE
## 5 Vehicle Movement 0.4347826 SKIDDINGAnalysis 4: Substance Abuse and Injury Correlation
Research Question
Is there a higher injury rate correlated with substance abuse?
# Analysis of substance abuse and injury severity
substance_summary <- crash_clean %>%
group_by(Driver.Substance.Abuse) %>%
summarise(
crash_count = n(),
severe_crashes = sum(Injury.Severity %in% c("FATAL INJURY", "SUSPECTED SERIOUS INJURY")),
severity_rate = severe_crashes / crash_count
)
# Visualization code will go hereConclusions
Our comprehensive analysis of traffic crash data has revealed critical patterns in crash severity influenced by multiple factors. The statistical evidence demonstrates that crash severity is not randomly distributed but rather follows distinct patterns tied to specific conditions and behaviors. The most severe crashes are predominantly associated with vehicle movement issues, particularly skidding incidents (0.435 severity score), followed by distracted driving behaviors, especially texting while driving (0.388 severity score). Traffic control infrastructure, specifically at signalized intersections (0.311 severity score), also plays a significant role in crash severity. The temporal analysis revealed that nighttime driving consistently presents higher risks (0.295 severity score), while weather conditions, particularly wintry mix situations (0.299 severity score), create hazardous driving environments. These findings are supported by robust statistical evidence, with chi-square tests showing extremely significant relationships between both weather (χ² = 732.51, p < 0.001) and traffic control (χ² = 1173.62, p < 0.001) factors and crash severity. The interplay between these factors suggests that crash severity is often the result of multiple concurrent risk factors, requiring a multi-faceted approach to traffic safety improvements. The data clearly indicates that human factors, particularly attention and vehicle control, combine with environmental and infrastructure conditions to create varying levels of risk on our roadways. ## Recommendations
Based on our analysis, we propose the following evidence-based recommendations: 1. Vehicle Control and Driver Training The high severity of skidding-related crashes (0.435) suggests an urgent need for:
Implementation of mandatory winter driving training programs Enhanced driver education focusing on vehicle control in adverse conditions Promotion of vehicle safety features that assist with stability control Regular vehicle maintenance campaigns focusing on tire and brake condition
- Distracted Driving Prevention With phone-related distractions showing severe outcomes (0.388), we recommend:
Strengthening enforcement of texting-while-driving laws Implementing public awareness campaigns highlighting the statistical risks Encouraging the use of phone-blocking technology while driving Creating designated safe zones for necessary phone use at regular intervals on major highways
- Infrastructure Improvements Given the high severity at traffic signals (0.311), we suggest:
Reviewing and optimizing traffic signal timing at high-risk intersections Installing advanced warning systems for upcoming traffic signals Implementing smart traffic control systems that adapt to real-time conditions Enhanced lighting and visibility improvements at signalized intersections
- Weather-Related Safety Measures To address weather-related severity (0.299), we propose:
Developing real-time weather alert systems for drivers Installing dynamic speed limit signs that adjust to weather conditions Improving road surface treatments during winter conditions Creating weather-specific traffic management protocols
- Nighttime Safety Enhancements To mitigate nighttime risks (0.295), we recommend:
Upgrading street lighting in high-risk areas Installing reflective road markers and enhanced signage Implementing night-specific speed limits in high-risk areas Encouraging the use of enhanced vehicle lighting systems
- Long-Term Monitoring and Evaluation To ensure ongoing improvement:
Establish a continuous monitoring system for crash severity patterns Conduct regular evaluations of implemented safety measures Update safety protocols based on new data and findings Maintain a public dashboard of safety metrics and improvements
These recommendations should be implemented in phases, prioritizing measures that address the most severe risk factors first. Regular evaluation of their effectiveness will allow for adjustments and improvements as needed. ## References
Maryland Crash Records